PC-X 1997 October/pcx14_9710.iso/swag/delphi.swg/0178_Some general methods to control Windows.pas

Pascal/Delphi Source File | 1996-08-30 | 4.9 KB | 217 lines

(*
  DESCRIPTION A simple component with some methods to control windows
  AUTHOR      Harm van Zoest, email [e-mail]
  VERSION     0.95 (beta), 07-05-96
  REMARK      If you have comments, found bugs or you add some interestig new features,
              please mail me!
*)

unit WinUtil;

interface

uses
  Classes, ExtCtrls;

type
  TWinUtil = class(TComponent)
  private
    FTimer: TTimer;
    Expired: Boolean;
    procedure Expire(Sender: TObject);
    function GetInterval: LongInt;
    procedure SetInterval(AInterval: LongInt);
    procedure Sleep;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Restart;
    procedure Reboot;
    procedure ShutDown;
    procedure CopyFile( source, dest : string);
    procedure SleepFor(AInterval: LongInt);
    function GetEnvironvar(const VariableName: string): string;
    function GetWindir: string;
    function GetCompanyName: string;
    function GetUserName : string;
  published
    property Interval: LongInt read GetInterval write SetInterval;
  end;

procedure Register;

implementation

uses
  WinTypes, WinProcs,LZexpand, sysutils,Forms;

constructor TWinUtil.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
end;

destructor TWinUtil.Destroy;
begin
  FTimer.Free;
  FTimer := nil;
  inherited Destroy;
end;

procedure TWinUtil.Expire(Sender: TObject);
begin
   Expired := True;
end;

function TWinUtil.GetInterval: LongInt;
begin
if Assigned(FTimer) then
  Result := FTimer.Interval
else Result := 0;
end;

procedure TWinUtil.SetInterval(AInterval: LongInt);
begin
  if Assigned(FTimer) then
    FTimer.Interval := AInterval;
end;

procedure TWinUtil.Sleep;
begin
  if Assigned(FTimer) then
  begin
    Expired := False;
    FTimer.OnTimer := Expire;
    FTimer.Enabled := True;
  repeat
      Application.ProcessMessages;
  until Expired;
  FTimer.Enabled := False;
  end;
end;

procedure TWinUtil.SleepFor(AInterval: LongInt);
begin
  if Assigned(FTimer) then
  begin
    if FTimer.Interval <> AInterval then
      FTimer.Interval := AInterval;
    Sleep;
    end;
end;

function TWinUtil.GetEnvironVar(const VariableName: string): string;
var
  APChar, VPChar: PChar;
begin
  GetMem(VPChar, Length(VariableName) + 1);
  { place the pascal-style string in a null-terminated one}
  StrPCopy(VPChar, VariableName);
  APChar:=GetDOSEnvironment;
  while not ((APChar^ = #1) or
             (StrLIComp(APChar, VPChar, (StrScan(APChar, '=') - APChar)) = 0)) do
       Inc(APChar, StrLen(APChar) + 1);
  FreeMem(VPChar, Length(VariableName) + 1);
  if APChar^ = #1 then
    Result:=''
  else
    Result:=Copy(StrPas(APChar), (StrScan(APChar, '=') - APChar) + 2, 255);
end;{GetEnviron}


{ get the windows dir}
function TWinUtil.GetWindir: string;
var
  x : word;
  buf : Pchar;
begin
  { get memory}
  Getmem(buf , 500);
  { call api funtion}
  x := GetWindowsDirectory(buf,500);
  GetWindir := StrPas(buf);
  Freemem(buf,500);
end;{GetWindir}



procedure TWinUtil.Restart;
var
  rc : boolean;
begin
  rc := ExitWindows(ew_restartwindows, 0);
end;

procedure TWinUtil.Reboot;
var
  rc : boolean;
begin
  rc := ExitWindows(ew_rebootsystem, 0);
end;

procedure TWinUtil.Shutdown;
var
  rc : boolean;
begin
  rc := ExitWindows(0, 0);
end;

procedure TWinUtil.CopyFile( source, dest : string);
var
  fil : Pchar;
  HandleSource, HandleDest : integer;
  rec : TOFStruct;
  x : longint;
begin
  { get the handle voor de source file}
  Getmem(fil, (length(source)+1));
  strPcopy(fil, source);
  { get the handle which identifies the source file}
  HandleSource := LZOpenfile(fil,rec, OF_READWRITE);
  FreeMem(fil,length(source)+1);
  { create a desination file}
  Getmem(fil, (length(dest)+1));
  strPcopy(fil, dest);
  _lcreat(fil, 0);
  { get the handle which identifies the destination file}
  HandleDest := LZOpenfile(fil, rec, OF_READWRITE);
  { now, we are ready to copy the file}
  x:= LZCopy(HandleSource, HandleDest);
  Freemem(fil,( length(dest) +1));
end;

function TWinUtil.GetUserName: string;
var
  fileHandle : Thandle ;
  fileBuffer: Array [0..29] of Char;
begin
  fileHandle := LoadLibrary('USER');
  if fileHandle >= HINSTANCE_ERROR then begin
       If LoadString(fileHandle, 514, @fileBuffer, 30) <> 0 Then
      GetUserName := fileBuffer;
  FreeLibrary(fileHandle);
  end;{if}
end;{GetUserName}

function TWinUtil.GetCompanyName: string;
var
  fileHandle : Thandle;
  fileBuffer: Array [0..29] of Char;
begin
  fileHandle := LoadLibrary('USER');
  if fileHandle >= HINSTANCE_ERROR then begin
       If LoadString(fileHandle, 515, @fileBuffer, 30) <> 0 Then
      GetCompanyName := fileBuffer;
  FreeLibrary(fileHandle);
  end;{if}
end;{GetCompanyName}


procedure Register;
begin
RegisterComponents('System', [TWinUtil]);
end;

end.